home *** CD-ROM | disk | FTP | other *** search
Wrap
Text File | 1992-12-24 | 9.3 KB | 226 lines | [ TEXT/PJMM]
unit Parser; interface uses Globals; procedure parser (var ktot: longint; var ty: hdlstringarray0; var typ: hdlstringarray0; var typr: hdlintarray0; var nodetable: hdlarrayhdlnoderecord; var numnodes: longint; var error: str255); implementation procedure parser; label 992, 993; var i, j, k, l, m, n, del, jtot: longint; s1, s2, s3: boolean; procedure setnodefields (l, m, n: longint); begin numnodes := numnodes + 1; nodetable^^[numnodes] := hdlnoderecord(NewHandle(SizeOf(noderecord))); nodetable^^[numnodes]^^.optype := typ^^[l]^^; {This procedure sets up the nodetable, } nodetable^^[numnodes]^^.loptype := typ^^[m]^^; {using tokens in the expression to enter } nodetable^^[numnodes]^^.roptype := typ^^[n]^^; {into the various fields.} nodetable^^[numnodes]^^.op.index := ty^^[l]^^; nodetable^^[numnodes]^^.lop.index := ty^^[m]^^; nodetable^^[numnodes]^^.rop.index := ty^^[n]^^; end; procedure reset (l, m, n: longint); var k: longint; begin {This procedure first collapses the total working number of tokens, jtot,} jtot := jtot - n; {by n. It then resets the ordered arrays, ty^^[k], typ^^[k]^^, and typr^^[k],} for k := l to jtot do {to ty^^[k+n]^^, typ^^[k+n]^^, and, typr^^[k+n], from, k = l to jtot.} begin ty^^[k]^^ := ty^^[k + n]^^; typr^^[k] := typr^^[k + n]; typ^^[k]^^ := typ^^[k + n]^^; end; end; procedure setnodetoken (l: longint); begin ty^^[l]^^ := stringof(numnodes : 2); {This procedure defines a node token, typ^^[l], sets its} typ^^[l]^^ := 'node'; {value equal to the number of the node in the table, and} typr^^[l] := 0; {its precedence value to 0.} end; begin error := ''; jtot := ktot; {Initialize 'error' to the null string and set jtot = ktot,} {the number of tokens in the expression.} numnodes := 0; {Initialize number of nodes to zero.} j := 0; repeat j := j + 1; if j < 1 then j := 1; if (j + 1) <= jtot then s1 := (typ^^[j + 1]^^ = 'constant') or (typ^^[j + 1]^^ = 'variable') or (typ^^[j + 1]^^ = 'matrix') or (typ^^[j + 1]^^ = 'node'); if (j - 1) >= 0 then s2 := (typ^^[j - 1]^^ = 'constant') or (typ^^[j - 1]^^ = 'variable') or (typ^^[j - 1]^^ = 'matrix') or (typ^^[j - 1]^^ = 'node'); if (j - 3) >= 0 then s3 := (typ^^[j - 3]^^ = 'constant') or (typ^^[j - 3]^^ = 'variable') or (typ^^[j - 3]^^ = 'matrix') or (typ^^[j - 3]^^ = 'node'); if ((typ^^[j]^^ = 'unary') or (typ^^[j]^^ = 'function')) and s1 then begin setnodefields(j, j + 1, j + 1); {If we encounter a unary or function token, we will create a new} setnodetoken(j); {node in the nodetable by entering the unary or function token in} reset(j + 1, jtot, 1); {the table, along with its argument, then replace the unary or} j := j - 1; {function token (in the ordered list), with a node token which has} goto 992; {a value equal to the value of the node index. We then reorder the} end; {the array of tokens, and reset j to j-1.} if (ty^^[j]^^ = quote) and s2 then begin {If we encounter a quote and the token immediately to the left} setnodefields(j, j - 1, j - 1); {is an operand token (variable, constant, matrix, node), then} setnodetoken(j - 1); {we create a node in the nodetable. A node token is substituted } j := j - 1; {in the position of the argument of the quote, i.e., just to the} reset(j + 1, jtot, 1); {left of the quote (in the ordered array), the quote token is then} j := j - 1; {replaced by the next higher ordered token in the list. The quote} goto 992; {quote and its argument are entered in the nodetable and the array} end; {of tokens is reduced by one.} if (typ^^[j]^^ = 'binary') and (ty^^[j]^^ <> '(') then {If we encounter a binary token in the array which} {is not the left parenthesis, we will start to process.} begin { In the next bit of code, if we have a binary token two positions to the left of the jth token and the} {priority of the (j-2)nd token is greater than or equal to the priority of the jth token we will go ahead} {and process.} if (j - 2 >= 0) and (typ^^[j - 2]^^ <> 'binary') and (typ^^[j - 2]^^ <> 'unary') and (typ^^[j - 2]^^ <> 'function') then begin error := concat(ty^^[j - 2]^^, ' is not a binary token '); goto 993; end; while (j - 2 >= 0) and (typr^^[j - 2] >= typr^^[j]) and (typ^^[j - 2]^^ <> 'unary') and (typ^^[j - 2]^^ <> 'function') do begin { The token between the two operator tokens (binary) and the token just to the left of the leftmost} {binary token must both be operand tokens, otherwise an error.} if (not s2) and (not s3) then begin error := concat(ty^^[j - 3]^^, ' and ', ty^^[j - 1]^^, ' are not both operand tokens'); goto 993; end; {We create a node in the nodetable, entering the binary operator } setnodefields(j - 2, j - 3, j - 1); {token and the two operand tokens in the table, set the node token } setnodetoken(j - 3); {position in the ordered array to the position of the leftmost binary} {token.} j := j - 3; {Starting with the (j-2) nd position within the array, we} reset(j + 1, jtot, 2); {reorder the array, collapsing it by 2.} goto 992; end; if ty^^[j]^^ = rightparen then begin if (ty^^[j - 2]^^ <> leftparen) or (not s2) then begin error := ' ty^^[j-2]^^ <> leftparen token or ty^^[j-1] ^^<> an operand token'; error := concat(ty^^[j - 2]^^, ' is not a left parenthesis token or ', ty^^[j - 1]^^, ' is not an operand token'); goto 993; end; if (jtot = 4) and (ty^^[j - 2]^^ = leftparen) and (ty^^[j]^^ = rightparen) then { If the token ty^^[j] ^^is a ")" and ty^^[j-2]^^is a "(", then we want to delete the} {parenentheses, and set up a unary node, since the operator has just one token} {following it. As an example, "-3". The "3" has no parenthesis around it, but we} {still have to change its value from "3" to "-3". So, this necessitates a node point} {and an entry into the node table.} begin numnodes := numnodes + 1; nodetable^^[numnodes] := hdlnoderecord(NewHandle(SizeOf(noderecord))); nodetable^^[numnodes]^^.optype := 'unary'; nodetable^^[numnodes]^^.loptype := typ^^[j - 1]^^; nodetable^^[numnodes]^^.roptype := typ^^[j - 1]^^; nodetable^^[numnodes]^^.op.index := plus; nodetable^^[numnodes]^^.lop.index := ty^^[j - 1]^^; nodetable^^[numnodes]^^.rop.index := ty^^[j - 1]^^; ty^^[j - 2]^^ := ty^^[j - 1]^^; typr^^[j - 2] := typr^^[j - 1]; typ^^[j - 2]^^ := typ^^[j - 1]^^; j := j - 2; reset(j + 1, jtot, 2); j := 2; ty^^[j]^^ := semicolon; goto 992; end; ty^^[j - 2]^^ := ty^^[j - 1]^^; typr^^[j - 2] := typr^^[j - 1]; typ^^[j - 2]^^ := typ^^[j - 1]^^; j := j - 2; reset(j + 1, jtot, 2); j := j - 2; if j <= 0 then j := 0; end; { In the following, if jtot = 2 and j = 2, and the first token is an operand token, we create a unary} {node, then exit the program.} if (jtot = 2) and (j = 2) then if (typ^^[j - 1]^^ = 'variable') or (typ^^[j - 1]^^ = 'constant') or (typ^^[j - 1]^^ = 'matrix') or (typ^^[j - 1]^^ = 'node') then begin numnodes := numnodes + 1; nodetable^^[numnodes] := hdlnoderecord(NewHandle(SizeOf(noderecord))); nodetable^^[numnodes]^^.optype := 'unary'; nodetable^^[numnodes]^^.loptype := typ^^[j - 1]^^; nodetable^^[numnodes]^^.roptype := typ^^[j - 1]^^; nodetable^^[numnodes]^^.op.index := plus; nodetable^^[numnodes]^^.lop.index := ty^^[j - 1]^^; nodetable^^[numnodes]^^.rop.index := ty^^[j - 1]^^; ty^^[j]^^ := semicolon; end; 992: end; until ty^^[j]^^ = semicolon; {The process ends when we encounter a semicolon. However,} {j must be equal to 2.} if j <> 2 then error := 'possible incorrect pairing of parentheses'; 993: ktot := jtot; end; end.